module cubed_sphere_halo_mod

  use mpi
  use flogger
  use kinds_mod
  use mesh_const_mod
  use var_types_mod
  use cubed_sphere_domain_mod

  implicit none

  integer, parameter ::                null_halo = 0
  integer, parameter ::               inner_halo = 1
  integer, parameter ::  left_bottom_domain_halo = 2
  integer, parameter ::  bottom_left_domain_halo = 3
  integer, parameter ::       bottom_domain_halo = 4
  integer, parameter :: bottom_right_domain_halo = 5
  integer, parameter :: right_bottom_domain_halo = 6
  integer, parameter ::        right_domain_halo = 7
  integer, parameter ::    right_top_domain_halo = 8
  integer, parameter ::    top_right_domain_halo = 9
  integer, parameter ::          top_domain_halo = 10
  integer, parameter ::     top_left_domain_halo = 11
  integer, parameter ::     left_top_domain_halo = 12
  integer, parameter ::         left_domain_halo = 13
  integer, parameter ::           left_edge_halo = 14 ! NOT USED
  integer, parameter ::          right_edge_halo = 15 ! NOT USED
  integer, parameter ::            top_edge_halo = 16 ! NOT USED
  integer, parameter ::         bottom_edge_halo = 17 ! NOT USED

  integer, parameter :: dtype_map(2) = [ &
    MPI_DOUBLE , & ! dtype_r8
    MPI_LOGICAL  & ! dtype_l
  ]

  type cubed_sphere_halo_type
    logical :: initialized  = .false.
    integer :: host_id      = MPI_PROC_NULL
    integer :: proc_id      = MPI_PROC_NULL
    integer :: idom         = 0
    integer :: orient       = 0
    integer :: type         = 0
    integer :: send_type_2d(size(dtype_map)) = MPI_DATATYPE_NULL
    integer :: recv_type_2d(size(dtype_map)) = MPI_DATATYPE_NULL
    integer :: send_type_3d(size(dtype_map)) = MPI_DATATYPE_NULL
    integer :: recv_type_3d(size(dtype_map)) = MPI_DATATYPE_NULL
    integer :: send_array_size    (3) = 0
    integer :: recv_array_size    (3) = 0
    integer :: send_subarray_size (3) = 0
    integer :: recv_subarray_size (3) = 0
    integer :: send_subarray_start(3) = 0
    integer :: recv_subarray_start(3) = 0
  contains
    procedure :: init   => cubed_sphere_halo_init
    procedure :: clear  => cubed_sphere_halo_clear
    final :: cubed_sphere_halo_final
  end type cubed_sphere_halo_type

contains

  subroutine cubed_sphere_halo_init(this, domain, orient, host_id, proc_id)

    class(cubed_sphere_halo_type), intent(inout) :: this
    type(cubed_sphere_domain_type), intent(in), target :: domain
    integer, intent(in) :: orient
    integer, intent(in) :: host_id
    integer, intent(in) :: proc_id

    type(cubed_sphere_domain_type), pointer :: d0, d1
    integer i, ierr, nx, ny, nz, depth, ex
    integer nmx, nmy, nmz

    this%orient  = orient
    this%host_id = host_id
    this%proc_id = proc_id

    d0 => domain ! Shorthand
    d1 => null()

    ! Set halo type according to orient and edge touch status.
    this%type = inner_halo
    select case (orient)
    case (left_bottom)
      if (d0%touch_edges(left) .and. d0%touch_edges(bottom)) then
        this%type = null_halo
      else if (d0%touch_edges(left)) then
        this%type = merge(null_halo, left_bottom_domain_halo, d0%ngb(1)%ptr%active)
      else if (d0%touch_edges(bottom)) then
        this%type = merge(null_halo, bottom_left_domain_halo, d0%ngb(3)%ptr%active)
      end if
    case (bottom)
      if (d0%touch_edges(bottom)) then
        this%type = merge(null_halo, bottom_domain_halo, d0%ngb(3)%ptr%active)
      end if
    case (right_bottom)
      if (d0%touch_edges(right) .and. d0%touch_edges(bottom)) then
        this%type = null_halo
      else if (d0%touch_edges(right)) then
        this%type = merge(null_halo, right_bottom_domain_halo, d0%ngb(2)%ptr%active)
      else if (d0%touch_edges(bottom)) then
        this%type = merge(null_halo, bottom_right_domain_halo, d0%ngb(3)%ptr%active)
      end if
    case (right)
      if (d0%touch_edges(right)) then
        this%type = merge(null_halo, right_domain_halo, d0%ngb(2)%ptr%active)
      end if
    case (right_top)
      if (d0%touch_edges(right) .and. d0%touch_edges(top)) then
        this%type = null_halo
      else if (d0%touch_edges(right)) then
        this%type = merge(null_halo, right_top_domain_halo, d0%ngb(2)%ptr%active)
      else if (d0%touch_edges(top)) then
        this%type = merge(null_halo, top_right_domain_halo, d0%ngb(4)%ptr%active)
      end if
    case (top)
      if (d0%touch_edges(top)) then
        this%type = merge(null_halo, top_domain_halo, d0%ngb(4)%ptr%active)
      end if
    case (left_top)
      if (d0%touch_edges(left) .and. d0%touch_edges(top)) then
        this%type = null_halo
      else if (d0%touch_edges(left)) then
        this%type = merge(null_halo, left_top_domain_halo, d0%ngb(1)%ptr%active)
      else if (d0%touch_edges(top)) then
        this%type = merge(null_halo, top_left_domain_halo, d0%ngb(4)%ptr%active)
      end if
    case (left)
      if (d0%touch_edges(left)) then
        this%type = merge(null_halo, left_domain_halo, d0%ngb(1)%ptr%active)
      end if
    end select

    ! Do not handle null halo.
    if (this%type == null_halo) then
      this%initialized = .true.
      return
    end if
    
    nmx = d0%ime-d0%ims+1
    nmy = d0%jme-d0%jms+1
    nmz = d0%kme-d0%kms+1
    this%send_array_size = [d0%ime-d0%ims+1,d0%jme-d0%jms+1,d0%kme-d0%kms+1]

    ! NOTE: MPI array index starts from zero.
    nx = d0%nbx; ny = d0%nby; nz = d0%nz
    select case (this%type)
    case (inner_halo)
    ! --------------------------------------------------------------------------
    !                                INNER HALO
      this%recv_array_size = this%send_array_size
      select case (orient)
      case (left_bottom)
        this%send_subarray_start = [d0%hw(1)            ,d0%hw(3)             ,0  ]
        this%recv_subarray_start = [d0%hw(1)-d0%hw0     ,d0%hw(3)-d0%hw0      ,0  ]
        this%send_subarray_size  = [d0%hw0              ,d0%hw0               ,nmz]
        this%recv_subarray_size  = [d0%hw0              ,d0%hw0               ,nmz]
      case (bottom)
        this%send_subarray_start = [d0%hw(1)            ,d0%hw(3)             ,0  ]
        this%recv_subarray_start = [d0%hw(1)            ,0                    ,0  ]
        this%send_subarray_size  = [nx                  ,d0%hw(3)             ,nmz]
        this%recv_subarray_size  = [nx                  ,d0%hw(3)             ,nmz]
      case (right_bottom)
        this%send_subarray_start = [nx+d0%hw(1)-d0%hw0  ,d0%hw(3)             ,0  ]
        this%recv_subarray_start = [nx+d0%hw(1)         ,d0%hw(3)-d0%hw0      ,0  ]
        this%send_subarray_size  = [d0%hw0              ,d0%hw0               ,nmz]
        this%recv_subarray_size  = [d0%hw0              ,d0%hw0               ,nmz]
      case (right)
        this%send_subarray_start = [nx+d0%hw(1)-d0%hw(2),d0%hw(3)             ,0  ]
        this%recv_subarray_start = [nx+d0%hw(1)         ,d0%hw(3)             ,0  ]
        this%send_subarray_size  = [d0%hw(2)            ,ny                   ,nmz]
        this%recv_subarray_size  = [d0%hw(2)            ,ny                   ,nmz]
      case (right_top)
        this%send_subarray_start = [nx+d0%hw(1)-d0%hw0  ,ny+d0%hw(3)-d0%hw0   ,0  ]
        this%recv_subarray_start = [nx+d0%hw(1)         ,ny+d0%hw(3)          ,0  ]
        this%send_subarray_size  = [d0%hw0              ,d0%hw0               ,nmz]
        this%recv_subarray_size  = [d0%hw0              ,d0%hw0               ,nmz]
      case (top)
        this%send_subarray_start = [d0%hw(1)            ,ny+d0%hw(3)-d0%hw(4) ,0  ]
        this%recv_subarray_start = [d0%hw(1)            ,ny+d0%hw(3)          ,0  ]
        this%send_subarray_size  = [nx                  ,d0%hw(4)             ,nmz]
        this%recv_subarray_size  = [nx                  ,d0%hw(4)             ,nmz]
      case (left_top)
        this%send_subarray_start = [d0%hw(1)            ,ny+d0%hw(3)-d0%hw0   ,0  ]
        this%recv_subarray_start = [d0%hw(1)-d0%hw0     ,ny+d0%hw(3)          ,0  ]
        this%send_subarray_size  = [d0%hw0              ,d0%hw0               ,nmz]
        this%recv_subarray_size  = [d0%hw0              ,d0%hw0               ,nmz]
      case (left)
        this%send_subarray_start = [d0%hw(1)            ,d0%hw(3)             ,0  ]
        this%recv_subarray_start = [0                   ,d0%hw(3)             ,0  ]
        this%send_subarray_size  = [d0%hw(1)            ,ny                   ,nmz]
        this%recv_subarray_size  = [d0%hw(1)            ,ny                   ,nmz]
      end select
    ! --------------------------------------------------------------------------
    !                               DOMAIN HALO
    case (left_bottom_domain_halo)
      d1 => d0%ngb(1)%ptr
      this%idom = d1%id
      this%recv_array_size = [d1%ime-d1%ims+1,d1%jme-d1%jms+1,nmz]
      ex = d0%ex(left_bottom)
      select case (d0%ngb(1)%code)
      case (14, 21, 32, 43)
        depth = d1%nbx + ex
        this%recv_subarray_start = [d1%hw(1)-ex         ,0                    ,0  ]
        this%recv_subarray_size  = [depth               ,d1%hw(3)             ,nmz]
      case (64)
        depth = d1%nby + ex
        this%recv_subarray_start = [0                   ,d1%hw(3)             ,0  ]
        this%recv_subarray_size  = [d1%hw(1)            ,depth                ,nmz]
      case (54)
        depth = d1%nby + ex
        this%recv_subarray_start = [ny+d1%hw(1)         ,d1%hw(3)-ex          ,0  ]
        this%recv_subarray_size  = [d1%hw(2)            ,depth                ,nmz]
      end select
      this%send_subarray_start   = [d0%hw(1)            ,d0%hw(3)             ,0  ]
      this%send_subarray_size    = [depth               ,d0%hw(3)             ,nmz]
    case (bottom_left_domain_halo)
      d1 => d0%ngb(3)%ptr
      this%idom = d1%id
      this%recv_array_size = [d1%ime-d1%ims+1,d1%jme-d1%jms+1,nmz]
      ex = d0%ex(left_bottom)
      select case (d0%ngb(3)%code)
      case (16, 51)
        depth = d1%nby + ex
        this%recv_subarray_start = [0                   ,d1%hw(3)-ex          ,0  ]
        this%recv_subarray_size  = [d1%hw(1)            ,depth                ,nmz]
      case (26)
        depth = d1%nbx + ex
        this%recv_subarray_start = [d1%hw(1)-ex         ,nx+d1%hw(3)          ,0  ]
        this%recv_subarray_size  = [depth               ,d1%hw(4)             ,nmz]
      case (46)
        depth = d1%nbx + ex
        this%recv_subarray_start = [d1%hw(1)            ,0                    ,0  ]
        this%recv_subarray_size  = [depth               ,d1%hw(3)             ,nmz]
      case (36, 63)
        depth = d1%nby + ex
        this%recv_subarray_start = [nx+d1%hw(1)         ,d1%hw(3)             ,0  ]
        this%recv_subarray_size  = [d1%hw(2)            ,depth                ,nmz]
      end select
      this%send_subarray_start   = [d0%hw(1)            ,d0%hw(3)             ,0  ]
      this%send_subarray_size    = [d0%hw(1)            ,depth                ,nmz]
    case (bottom_domain_halo)
      d1 => d0%ngb(3)%ptr
      this%idom = d1%id
      this%recv_array_size = [d1%ime-d1%ims+1,d1%jme-d1%jms+1,nmz]
      ex = d0%ex(bottom)
      select case (d0%ngb(3)%code)
      case (16, 51)
        depth = d1%nby + ex
        this%recv_subarray_start = [d1%hw(1)            ,d1%hw(3)-ex          ,0  ]
        this%recv_subarray_size  = [nx                  ,depth                ,nmz]
      case (26)
        depth = d1%nbx + ex
        this%recv_subarray_start = [d1%hw(1)-ex         ,d1%hw(3)             ,0  ]
        this%recv_subarray_size  = [depth               ,nx                   ,nmz]
      case (46)
        depth = d1%nbx + ex
        this%recv_subarray_start = [d1%hw(1)            ,d1%hw(3)             ,0  ]
        this%recv_subarray_size  = [depth               ,nx                   ,nmz]
      case (36, 63)
        depth = d0%ngb(3)%ptr%nby + ex
        this%recv_subarray_start = [d1%hw(1)            ,d1%hw(3)             ,0  ]
        this%recv_subarray_size  = [nx                  ,depth                ,nmz]
      end select
      this%send_subarray_start   = [d0%hw(1)            ,d0%hw(3)             ,0  ]
      this%send_subarray_size    = [nx                  ,depth                ,nmz]
    case (right_bottom_domain_halo)
      d1 => d0%ngb(2)%ptr
      this%idom = d1%id
      this%recv_array_size = [d1%ime-d1%ims+1,d1%jme-d1%jms+1,nmz]
      ex = d0%ex(right_bottom)
      select case (d0%ngb(2)%code)
      case (12, 23, 34, 41)
        depth = d1%nbx + ex
        this%recv_subarray_start = [d1%hw(1)            ,0                    ,0  ]
        this%recv_subarray_size  = [depth               ,d1%hw(3)             ,nmz]
      case (52)
        depth = d1%nby + ex
        this%recv_subarray_start = [0                   ,d1%hw(3)-ex          ,0  ]
        this%recv_subarray_size  = [d1%hw(1)            ,depth                ,nmz]
      case (62)
        depth = d1%nby + ex
        this%recv_subarray_start = [ny+d1%hw(1)         ,d1%hw(3)             ,0  ]
        this%recv_subarray_size  = [d1%hw(2)            ,depth                ,nmz]
      end select
      this%send_subarray_start   = [nx+d0%hw(1)-depth   ,d0%hw(3)             ,0  ]
      this%send_subarray_size    = [depth               ,d0%hw(3)             ,nmz]
    case (bottom_right_domain_halo)
      d1 => d0%ngb(3)%ptr
      this%idom = d1%id
      this%recv_array_size = [d1%ime-d1%ims+1,d1%jme-d1%jms+1,nmz]
      ex = d0%ex(right_bottom)
      select case (d0%ngb(3)%code)
      case (16, 51)
        depth = d1%nby + ex
        this%recv_subarray_start = [nx+d1%hw(1)         ,d1%hw(3)-ex          ,0  ]
        this%recv_subarray_size  = [d1%hw(2)            ,depth                ,nmz]
      case (26)
        depth = d1%nbx + ex
        this%recv_subarray_start = [d1%hw(1)-ex         ,0                    ,0  ]
        this%recv_subarray_size  = [depth               ,d1%hw(3)             ,nmz]
      case (46)
        depth = d1%nbx + ex
        this%recv_subarray_start = [d1%hw(1)            ,nx+d1%hw(3)          ,0  ]
        this%recv_subarray_size  = [depth               ,d1%hw(4)             ,nmz]
      case (36, 63)
        depth = d1%nby + ex
        this%recv_subarray_start = [0                   ,d1%hw(3)             ,0  ]
        this%recv_subarray_size  = [d1%hw(1)            ,depth                ,nmz]
      end select
      this%send_subarray_start   = [nx+d0%hw(1)-d0%hw(2),d0%hw(3)             ,0  ]
      this%send_subarray_size    = [d0%hw(2)            ,depth                ,nmz]
    case (right_domain_halo)
      d1 => d0%ngb(2)%ptr
      this%idom = d1%id
      this%recv_array_size = [d1%ime-d1%ims+1,d1%jme-d1%jms+1,nmz]
      ex = d0%ex(right)
      select case (d0%ngb(2)%code)
      case (12, 23, 34, 41)
        depth = d1%nbx + ex
        this%recv_subarray_start = [d1%hw(1)            ,d1%hw(3)             ,0  ]
        this%recv_subarray_size  = [depth               ,ny                   ,nmz]
      case (52)
        depth = d1%nby + ex
        this%recv_subarray_start = [d1%hw(1)            ,d1%hw(3)-ex          ,0  ]
        this%recv_subarray_size  = [ny                  ,depth                ,nmz]
      case (62)
        depth = d1%nby + ex
        this%recv_subarray_start = [d1%hw(1)            ,d1%hw(3)             ,0  ]
        this%recv_subarray_size  = [ny                  ,depth                ,nmz]
      end select
      this%send_subarray_start   = [nx+d0%hw(1)-depth   ,d0%hw(3)             ,0  ]
      this%send_subarray_size    = [depth               ,ny                   ,nmz]
    case (right_top_domain_halo)
      d1 => d0%ngb(2)%ptr
      this%idom = d1%id
      this%recv_array_size = [d1%ime-d1%ims+1,d1%jme-d1%jms+1,nmz]
      ex = d0%ex(right_top)
      select case (d0%ngb(2)%code)
      case (12, 23, 34, 41)
        depth = d1%nbx + ex
        this%recv_subarray_start = [d1%hw(1)            ,ny+d1%hw(3)          ,0  ]
        this%recv_subarray_size  = [depth               ,d1%hw(4)             ,nmz]
      case (52)
        depth = d1%nby + ex
        this%recv_subarray_start = [ny+d1%hw(1)         ,d1%hw(3)-ex          ,0  ]
        this%recv_subarray_size  = [d1%hw(2)            ,depth                ,nmz]
      case (62)
        depth = d1%nby + ex
        this%recv_subarray_start = [0                   ,d1%hw(3)             ,0  ]
        this%recv_subarray_size  = [d1%hw(1)            ,depth                ,nmz]
      end select
      this%send_subarray_start   = [nx+d0%hw(1)-depth   ,ny+d0%hw(3)-d0%hw(4) ,0  ]
      this%send_subarray_size    = [depth               ,d0%hw(4)             ,nmz]
    case (top_right_domain_halo)
      d1 => d0%ngb(4)%ptr
      this%idom = d1%id
      this%recv_array_size = [d1%ime-d1%ims+1,d1%jme-d1%jms+1,nmz]
      ex = d0%ex(right_top)
      select case (d0%ngb(4)%code)
      case (15, 61)
        depth = d1%nby + ex
        this%recv_subarray_start = [nx+d1%hw(1)         ,d1%hw(3)             ,0  ]
        this%recv_subarray_size  = [d1%hw(2)            ,depth                ,nmz]
      case (45)
        depth = d1%nbx + ex
        this%recv_subarray_start = [d1%hw(1)            ,0                    ,0  ]
        this%recv_subarray_size  = [depth               ,d1%hw(3)             ,nmz]
      case (25)
        depth = d1%nbx + ex
        this%recv_subarray_start = [d1%hw(1)-ex         ,nx+d1%hw(3)          ,0  ]
        this%recv_subarray_size  = [depth               ,d1%hw(4)             ,nmz]
      case (35, 53)
        depth = d1%nby + ex
        this%recv_subarray_start = [0                   ,d1%hw(3)-ex          ,0  ]
        this%recv_subarray_size  = [d1%hw(1)            ,depth                ,nmz]
      end select
      this%send_subarray_start   = [nx+d0%hw(1)-d0%hw(2),ny+d0%hw(3)-depth    ,0  ]
      this%send_subarray_size    = [d0%hw(2)            ,depth                ,nmz]
    case (top_domain_halo)
      d1 => d0%ngb(4)%ptr
      this%idom = d1%id
      this%recv_array_size = [d1%ime-d1%ims+1,d1%jme-d1%jms+1,nmz]
      ex = d0%ex(top)
      select case (d0%ngb(4)%code)
      case (15, 61)
        depth = d1%nby + ex
        this%recv_subarray_start = [d1%hw(1)            ,d1%hw(3)             ,0  ]
        this%recv_subarray_size  = [nx                  ,depth                ,nmz]
      case (45)
        depth = d1%nbx + ex
        this%recv_subarray_start = [d1%hw(1)            ,d1%hw(3)             ,0  ]
        this%recv_subarray_size  = [depth               ,nx                   ,nmz]
      case (25)
        depth = d1%nbx + ex
        this%recv_subarray_start = [d1%hw(1)-ex         ,d1%hw(3)             ,0  ]
        this%recv_subarray_size  = [depth               ,nx                   ,nmz]
      case (35, 53)
        depth = d1%nby + ex
        this%recv_subarray_start = [d1%hw(1)            ,d1%hw(3)-ex          ,0  ]
        this%recv_subarray_size  = [nx                  ,depth                ,nmz]
      end select
      this%send_subarray_start   = [d0%hw(1)            ,ny+d0%hw(3)-depth    ,0  ]
      this%send_subarray_size    = [nx                  ,depth                ,nmz]
    case (left_top_domain_halo)
      d1 => d0%ngb(1)%ptr
      this%idom = d1%id
      this%recv_array_size = [d1%ime-d1%ims+1,d1%jme-d1%jms+1,nmz]
      ex = d0%ex(left_top)
      select case (d0%ngb(1)%code)
      case (14, 21, 32, 43)
        depth = d1%nbx + ex
        this%recv_subarray_start = [d1%hw(1)-ex         ,ny+d1%hw(3)          ,0  ]
        this%recv_subarray_size  = [depth               ,d1%hw(4)             ,nmz]
      case (64)
        depth = d1%nby + ex
        this%recv_subarray_start = [ny+d1%hw(1)         ,d1%hw(3)             ,0  ]
        this%recv_subarray_size  = [d1%hw(2)            ,depth                ,nmz]
      case (54)
        depth = d1%nby + ex
        this%recv_subarray_start = [0                   ,d1%hw(3)-ex          ,0  ]
        this%recv_subarray_size  = [d1%hw(1)            ,depth                ,nmz]
      end select
      this%send_subarray_start   = [d0%hw(1)            ,ny+d0%hw(3)-d0%hw(4) ,0  ]
      this%send_subarray_size    = [depth               ,d0%hw(4)             ,nmz]
    case (top_left_domain_halo)
      d1 => d0%ngb(4)%ptr
      this%idom = d1%id
      this%recv_array_size = [d1%ime-d1%ims+1,d1%jme-d1%jms+1,nmz]
      ex = d0%ex(left_top)
      select case (d0%ngb(4)%code)
      case (15, 61)
        depth = d1%nby + ex
        this%recv_subarray_start = [0                   ,d1%hw(3)             ,0  ]
        this%recv_subarray_size  = [d1%hw(1)            ,depth                ,nmz]
      case (25)
        depth = d1%nbx + ex
        this%recv_subarray_start = [d1%hw(1)-ex         ,0                    ,0  ]
        this%recv_subarray_size  = [depth               ,d1%hw(3)             ,nmz]
      case (45)
        depth = d1%nbx + ex
        this%recv_subarray_start = [d1%hw(1)            ,nx+d1%hw(3)          ,0  ]
        this%recv_subarray_size  = [depth               ,d1%hw(4)             ,nmz]
      case (35, 53)
        depth = d1%nby + ex
        this%recv_subarray_start = [nx+d1%hw(1)         ,d1%hw(3)-ex          ,0  ]
        this%recv_subarray_size  = [d1%hw(2)            ,depth                ,nmz]
      end select
      this%send_subarray_start   = [d0%hw(1)            ,ny+d0%hw(3)-depth    ,0  ]
      this%send_subarray_size    = [d0%hw(1)            ,depth                ,nmz]
    case (left_domain_halo)
      d1 => d0%ngb(1)%ptr
      this%idom = d1%id
      this%recv_array_size = [d1%ime-d1%ims+1,d1%jme-d1%jms+1,nmz]
      ex = d0%ex(left)
      select case (d0%ngb(1)%code)
      case (14, 21, 32, 43)
        depth = d1%nbx + ex
        this%recv_subarray_start = [d1%hw(1)-ex         ,d1%hw(3)             ,0  ]
        this%recv_subarray_size  = [depth               ,ny                   ,nmz]
      case (64)
        depth = d1%nby + ex
        this%recv_subarray_start = [d1%hw(1)            ,d1%hw(3)             ,0  ]
        this%recv_subarray_size  = [ny                  ,depth                ,nmz]
      case (54)
        depth = d1%nby + ex
        this%recv_subarray_start = [d1%hw(1)            ,d1%hw(3)-ex          ,0  ]
        this%recv_subarray_size  = [ny                  ,depth                ,nmz]
      end select
      this%send_subarray_start   = [d0%hw(1)            ,d0%hw(3)             ,0  ]
      this%send_subarray_size    = [depth               ,ny                   ,nmz]
    end select

    !if (host_id == 0 .and. proc_id == 14) then
    !  write(0, *) 'host_id =', host_id, 'proc_id =', proc_id, 'orient =', orient, 'type =', this%type
    !  write(0, *) 'send_array_size     =', this%send_array_size
    !  write(0, *) 'recv_array_size     =', this%recv_array_size
    !  write(0, *) 'send_subarray_start =', this%send_subarray_start
    !  write(0, *) 'send_subarray_size  =', this%send_subarray_size
    !  write(0, *) 'recv_subarray_start =', this%recv_subarray_start
    !  write(0, *) 'recv_subarray_size  =', this%recv_subarray_size
    !  write(0, *) 'hw                  =', d0%hw
    !  if (associated(d1)) then
    !    write(0, *) 'ngb_hw              =', d1%hw
    !    write(0, *) 'depth               =', depth
    !    write(0, *) 'ex                  =', d0%ex
    !  end if
    !  stop
    !end if

    do i = 1, size(dtype_map)
      call MPI_TYPE_CREATE_SUBARRAY(3, this%send_array_size, this%send_subarray_size, &
                                    this%send_subarray_start, MPI_ORDER_FORTRAN, dtype_map(i), &
                                    this%send_type_3d(i), ierr)
      call MPI_TYPE_COMMIT(this%send_type_3d(i), ierr)
      call MPI_TYPE_CREATE_SUBARRAY(3, this%recv_array_size, this%recv_subarray_size, &
                                    this%recv_subarray_start, MPI_ORDER_FORTRAN, dtype_map(i), &
                                    this%recv_type_3d(i), ierr)
      call MPI_TYPE_COMMIT(this%recv_type_3d(i), ierr)

      call MPI_TYPE_CREATE_SUBARRAY(2, this%send_array_size, this%send_subarray_size, &
                                    this%send_subarray_start, MPI_ORDER_FORTRAN, dtype_map(i), &
                                    this%send_type_2d(i), ierr)
      call MPI_TYPE_COMMIT(this%send_type_2d(i), ierr)
      call MPI_TYPE_CREATE_SUBARRAY(2, this%recv_array_size, this%recv_subarray_size, &
                                    this%recv_subarray_start, MPI_ORDER_FORTRAN, dtype_map(i), &
                                    this%recv_type_2d(i), ierr)
      call MPI_TYPE_COMMIT(this%recv_type_2d(i), ierr)
    end do

    this%initialized = .true.

  end subroutine cubed_sphere_halo_init

  subroutine cubed_sphere_halo_clear(this)

    class(cubed_sphere_halo_type), intent(inout) :: this

    integer i, ierr

    do i = 1, size(this%send_type_2d)
      if (this%send_type_2d(i) /= MPI_DATATYPE_NULL) call MPI_TYPE_FREE(this%send_type_2d(i), ierr)
      if (this%recv_type_2d(i) /= MPI_DATATYPE_NULL) call MPI_TYPE_FREE(this%recv_type_2d(i), ierr)
      if (this%send_type_3d(i) /= MPI_DATATYPE_NULL) call MPI_TYPE_FREE(this%send_type_3d(i), ierr)
      if (this%recv_type_3d(i) /= MPI_DATATYPE_NULL) call MPI_TYPE_FREE(this%recv_type_3d(i), ierr)
    end do

    this%initialized         = .false.
    this%type                = null_halo
    this%host_id             = MPI_PROC_NULL
    this%proc_id             = MPI_PROC_NULL
    this%orient              =  0
    this%send_array_size     =  0
    this%recv_array_size     =  0
    this%send_subarray_start = -1
    this%send_subarray_size  =  0
    this%recv_subarray_start = -1
    this%recv_subarray_size  =  0

  end subroutine cubed_sphere_halo_clear

  subroutine cubed_sphere_halo_final(this)

    type(cubed_sphere_halo_type), intent(inout) :: this

    call this%clear()

  end subroutine cubed_sphere_halo_final

end module cubed_sphere_halo_mod
